home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1996 January / macformat-033.iso / mac / Shareware City / Developers / CGIshell Folder / Pocket 6.4 / Examples / Calculator next >
Encoding:
Text File  |  1993-06-23  |  17.9 KB  |  404 lines  |  [TEXT/McSk]
  1. page  0 28 +md !  ( kill echo )
  2.  
  3. \ A simple RPN floating point calculator.
  4. \ includes cut, copy, paste and undo!
  5. \ press tab to return to Pocket Forth.
  6.  
  7. forget task : task ; decimal
  8.  
  9.  
  10. \ rect stuff
  11. : RECT ( compile: -- )  \ define named storage for rect structure
  12.        ( run: -- addr ) variable 6 allot ;
  13. : !RECT ( t l b r addr -- )  \ set rect data
  14.     >r  swap r 4 + 2!  swap r> 2! ;
  15. : RERASE ( rect -- ) a>r ,$ A8A3 ( _EraseRect ) ;
  16. : RFRAME ( rect -- ) a>r ,$ A8A1 ( _FrameRect ) ;
  17. : RCLIP ( rect -- ) a>r ,$ A87B ( _ClipRect ) ;
  18.  
  19. \ window stuff
  20. : WINDOW ( -- d ) 0 +md 2@ ; \ d = window pointer
  21. : WSIZE ( h v -- )  \ change the window size
  22.     2dup  8 +md 2!  \ set the scroll rect 
  23.     window 2>r  2>r  256 >r  ,$ A91D ( _SizeWindow )
  24.     4 +md rclip ;   \ set drawing rect to whole window
  25. : WTITLE ( string.addr -- ) \ set the window title
  26.     window 2>r a>r ,$ A91A ( _SetWTitle ) ;
  27.  
  28. \ font stuff
  29. : !FONT ( n -- ) >r ,$ A887 ( _TextFont ) ; macro  \ set font
  30. : !FSIZE ( n -- ) >r ,$ A88A ( _TextSize ) ; macro  \ set size
  31. : !FACE ( face -- ) >r ,$ A888 ( _TextFace ) ; macro \ set style
  32. : !FMODE ( mode -- ) >r ,$ A889 ( _TextMode ) ; macro \ set mode
  33. : SYSFONT ( -- ) 0 !font  12 !fsize ;  \ set System font
  34. : MONACO9 ( -- ) 4 !font  09 !fsize  0 !fmode ;  \ set Normal font
  35.  
  36. \ old style (ie easy) color stuff
  37. : BLACK  33 0 2>r ,$ A862 ( _ForeColor ) ;  \ black
  38. : RED   205 0 2>r ,$ A862 ( _ForeColor ) ;  \ red
  39. : BLUE  409 0 2>r ,$ A862 ( _ForeColor ) ;  \ blue
  40.  
  41. \ string stuff
  42. : ?DEFINING ( -- flag ) cstate c@ ;     \ true if defining
  43. : ASCII ( -- c ) 32 word here 1+ c@     \ c = ascii of next character
  44.     ?defining IF literal THEN ; IMMEDIATE
  45. : EVEN ( n -- n' ) dup 2 mod + ;        \ round up to even number
  46. : ," ( -- )   ascii " word              \ get a quoted string
  47.     here c@ 1+ even allot ; IMMEDIATE
  48.  
  49. \ memory stuff: macros and create/dispose of handles
  50. : >D0 ( n -- ) ,$ 4280 ,$ 301E ; macro  \ clr.l d0  move (a6)+,d0
  51. : >A0 ( d -- ) ,$ 205E ; macro          \ movea.l (a6)+,a0
  52. : >A1 ( d -- ) ,$ 225E ; macro          ( movea.l        [a6]+,a0 )
  53. : D0> ( -- n ) ,$ 3D00 ; macro          \ move d0,-(a6)
  54. : A0> ( -- d ) ,$ 2D08 ; macro          \ move.l a0,-(a6)
  55. : HNEW ( size -- handle ) \ create a new handle
  56.     >d0 ,$ A122 ( _NewHandle )          \ create a block
  57.     a0> d0> IF                          \ check for error
  58.       beep 2r> 2drop exit THEN ;        \ beep & skip enclosing word
  59. : HDISP ( handle -- )     \ get rid of a handle
  60.     >a0 ,$ A023 ( _DisposHandle ) ;
  61. : BMOVE ( d.from d.to n -- ) \ move n bytes d.from -> d.to
  62.     >d0 >a1 >a0 ,$ A02E ( _BlockMove ) ;
  63.  
  64. \ stack checking
  65. : NEEDS ( n -- flag ) depth 1- > ;  \ true if less than n items on stack
  66. : ?OVERFLOW ( -- flag ) 1000 needs ; \ true if stack is not overflowing   
  67.  
  68. \ be sure 1 or 2 fp numbers are on the stack for operations
  69. : UNARY ( ? -- f ) 5 needs IF  0.0  THEN ; \ operation requires 1 arg.
  70. : BINARY ( ? -- f1 f2 ) 10 needs IF  unary 0.0 fswap  THEN ; \ 2 args.
  71.  
  72. \ fp comparison
  73. : FC ( f1 f2 -- tristate.flag ) fcompare >r fdrop fdrop r> ;
  74. : F0= ( f -- flag ) 0.0 fc 0= ;  \ true if f=0
  75. : F> ( f1 f2 -- flag ) fc 0> ;   \ true if f1>f2
  76. : F< ( f1 f2 -- flag ) fc 0< ;   \ true if f1<f2
  77.  
  78. \ trancendental functions (not included in Pocket Forth)
  79. : ACOS ( f -- acos[f] ) \ See Apple Numerics Manual, 2nd ed.
  80.     fdup 1.0 fswap f- fswap 1.0 f+ f/ fsqrt fatn 2.0 f* ;
  81. : ASIN ( f -- asin[f] ) \ See Apple Numerics Manual, 2nd ed.
  82.     fdup fabs 1.16415321827e-10 fcompare >r fdrop r> 0> IF
  83.       fdup 0.5 fcompare >r fdrop fdrop r> 0> IF
  84.         1. fswap f-  fdup 2. f* fswap fdup f* f-  ELSE
  85.         1. fswap fdup f* f-  THEN
  86.       fsqrt f/ fatn  ELSE
  87.       fdrop  THEN ;
  88. : PI ( -- f ) 0.0 acos 2.0 f* ;    \ 3.14159265358979324
  89. : D/R ( -- f ) 360. pi 2.0 f* f/ ; \ degrees/radian
  90.  
  91. : LOG ( f -- logf ) fln 10. fln f/ ;  \ log base 10
  92. \ : E ( -- f.e   7.0 fdup fln 1.0 fswap f/ f^ ;  \ Euler's number
  93.  
  94. \ compile time ticking  See file "Using Starting Forth".
  95. : ['] ( -- addr ) \ of the next word in a colon definition
  96.     token latest search IF literal
  97.     ELSE  here count type space ." not found." abort
  98.     THEN ; IMMEDIATE
  99.  
  100.  
  101. \ *** Application Specific part follows ***
  102.  
  103. \ some rects for drawing
  104. rect UPPER_RECT    0   0  75 201 upper_rect !rect   \ stack area window
  105. rect MARGIN_RECT   8   7  97 185 margin_rect !rect  \ leave a margin
  106. rect BUFFER_RECT  75  10  95 175 buffer_rect !rect  \ input buffer rect
  107.  
  108. \ window titles
  109. create "POCKETFORTH"  ," Pocket Forth"
  110. create "CALCULATOR"   ," Calculator"
  111.  
  112. \ display the stack
  113. variable PLACES  9 places !   \ number of decimal places to show
  114. : SPACES ( n -- ) 0 DO space LOOP ;  \ emit n spaces  NEVER BE ZERO!
  115. : BIG_CR ( -- ) @pen swap drop 16 + 1 swap !pen ;  \ bigger cr
  116. : L. ( n -- )  \ n = nth fp number on stack ( auto-formatting display )
  117.     5 spaces  dup 5 * needs 0= IF      
  118.       fpick ELSE  drop 0.0 THEN  \ -- f
  119.     fdup                         \ If real number, f, is
  120.     fdup fabs 1.e9  f> >r        \ bigger than 1 billion
  121.     fdup fabs 1.e-4 f< >r        \ or less than .0001
  122.     f0= 0= r> r> or and IF       \ but not zero...
  123.       places @ sci  ELSE         \ do scientific notation
  124.        places @ fix  THEN        \ do fixed point notation
  125.     f. big_cr ;                  \ show it, then move down
  126. : .STACK ( fn..f1 -- fn..f1 )  \ display fstack
  127.     margin_rect rclip            \ clip to keep margin clear
  128.     sysfont  upper_rect rerase   \ chicago 12, erase top of window
  129.     1 20 !pen                    \ set starting place
  130.     4 l.  3 l.  2 l.  1 l. ;     \ display 4 lines
  131.  
  132. \ display annunciators
  133. fvariable ATYPE  1. atype f!  \ 1=radians  d/r=degrees
  134. : .ANNUNCIATOR  \ draw angle type annunciator
  135.     margin_rect rclip            \ clip to keep margin clear
  136.     180 90 !pen  monaco9  red    \ red pen
  137.     atype f@ 1.0 f- f0= IF       \ 1=radians  othert = degrees
  138.       ." R" ELSE ." D" THEN  black ;
  139.  
  140. \ key press handling
  141. variable KFLAG  \ holds the pressed key
  142. : !KEY ( c -- ) kflag ! ;  0 !key  \ set key pressed
  143. : @KEY ( -- c ) kflag @ ;          \ get last key pressed
  144. : ?NUMERIC ( c -- flag ) \ true if c is numeric (or e or .)
  145.     dup 101 = >r  ( e )
  146.     dup  69 = >r  ( E )
  147.     dup  46 = >r  ( . )
  148.     dup  47 > >r  ( 0 ... 9 )
  149.     58 <  r> and  r> or  r> or  r> or ;
  150.  
  151. \ buffer key presses
  152. variable KBUFF 32 allot          \ hold multibyte input
  153. variable ^KBUFF  kbuff ^kbuff !  \ place holder for above
  154. : #CHARS ( -- n )  \ no. of characters in input buffer
  155.     ^kbuff @ kbuff 1+ - ;
  156. : KEY>BUFFER ( -- )  \ store the key into kbuff
  157.     @key ^kbuff @ c!  \ store character
  158.     1 ^kbuff +!        \ increment pointer
  159.     #chars kbuff c! ;   \ store length
  160.  
  161. \ put fp number on stack
  162. : FIRST_CHAR ( -- addr ) kbuff 1+ ;  \ first char of kbuff
  163. : INSERT_CHAR ( c -- )  \ insert c at start of kbuff
  164.     first_char  kbuff 2+  #chars cmove  \ move chars up one
  165.     first_char c!                       \ store c at beginning
  166.     kbuff c@ 1+ kbuff c!                \ incerment count
  167.     1 ^kbuff +! ;                       \ increment index
  168. : ENTER ( -- )  \ convert input buffer to a number
  169.     #chars IF                                     \ if there's any numbers
  170.       kbuff upper                                 \ be sure its E not e
  171.       first_char c@ 69 = IF  49 insert_char THEN  \ insert 1 if E
  172.       first_char c@ 46 = IF  48 insert_char THEN  \ insert 0 if .
  173.       kbuff >abs fnumber                          \ convert to number
  174.       first_char ^kbuff !  0 kbuff !              \ reset buffer
  175.     THEN ;
  176.  
  177. \ display the input buffer
  178. : .BUFFER
  179.     buffer_rect rclip  22 90 !pen            \ restrict pen to input area
  180.     buffer_rect rerase                        \ clear input rect
  181.     kbuff c@ IF sysfont kbuff count type THEN  \ type input buffer
  182.     buffer_rect rframe ;                        \ draw frame
  183.  
  184. \ display calculator
  185. : .CALC ( -- ) .stack .buffer .annunciator ;
  186.  
  187.  
  188. \ undo, cut, copy, paste & clear
  189. variable UDEPTH
  190. : UBUFF ( -- addr ) here 300 + ;  \ here+300 is used for the undo buffer
  191. : EMPTY_STACK  depth 0 DO drop LOOP ;  \ clear stack
  192. : KEEP ( -- )  \ save the stack in the undo buffer
  193.     depth 5 / udepth !
  194.     udepth @ 0 DO    \ put each fp number from stack into undo buffer
  195.       r 1+ fpick  ubuff r 10 * + f!  LOOP ;
  196. : RESTORE_STACK ( -- ... ) empty_stack  \ restore the stack
  197.     udepth @ IF
  198.       udepth @ 0 DO  \ put each item from undo buffer onto stack
  199.         ubuff  udepth @ 1- 10 * +  r 10 * -  f@  LOOP THEN ;
  200. : UNDO ( -- ... ) restore_stack .calc ;
  201.  
  202. 2variable IHANDLE  \ temporary handle holder
  203. : DEREF ( addr -- daddr ) 2@ dl@ ;    \ dereference a handle at addr
  204. : HANDLE>HERE ( n addr -- ) \ move n bytes from handle to here
  205.     deref                               \ get pointer from handle
  206.     rot dup here !                       \ store length
  207.     here 2+ >abs  rot  bmove              \ move to here+2
  208.     here 1+  here  here 1+ c@ 1+  cmove ;  \ move to here
  209. : SCRAP>STACK ( -- f ) \ Put ascii scrap onto stack as an fp number.
  210.     10 hnew ihandle 2!            \ create a handle
  211.     0 0 2>r                       \ room for result
  212.     ihandle 2@ 2>r                \ push handle to rstack
  213.     ,s TEXT 2>r                   \ scrap type identifier
  214.     here a>r                      \ offset variable
  215.       ,$ A9FD ( _GetScrap )
  216.     2r> 0< IF                     \ high byte indicates an error
  217.       drop                        \   drop bytes
  218.     ELSE                          \ no error
  219.       ihandle  handle>here        \   move string to here
  220.       here >abs  fnumber          \   convert string to number
  221.     THEN  ihandle 2@ hdisp ;      \ dispose of the handle
  222. : PASTE ( -- ) keep scrap>stack .calc ;
  223.  
  224. : F>HERE ( f -- f ) \ displaying a fp number leaves a copy at here
  225.     @pen 2>r 1 -20 !pen fdup f. 2r> !pen ;  \ copy f to here
  226. : STACK>SCRAP ( f -- f ) \ copy f to clipboard
  227.     0 0 2>r  ,$ A9FC ( _ZeroScrap )
  228.     f>here  here c@ 0 2>r         \ push length to rstack
  229.     ,s TEXT 2>r                   \ scrap type identifier
  230.     here 1+ a>r                   \ addr of text
  231.       ,$ A9FE                     \ _PutScrap
  232.     2r> + IF beep THEN ;          \ beep if error
  233. : COPY  enter unary stack>scrap .calc ;
  234. : CUT  keep enter unary stack>scrap fdrop .calc ;
  235. : CLEAR  keep empty_stack .stack ;
  236.  
  237. \ draw a tiny help screen (If turnkeying, use an alert.)
  238. : .HELP ( -- )
  239.     4 +md rclip  page  monaco9  8 !fsize  blue
  240.     10  9 !pen ." l  loG     n  nat loG    x  e^     +"
  241.     10 17 !pen ." \  abs     f  fraction   i  int    -"
  242.     10 25 !pen ." s  sin     c  cos        t  tan    *"
  243.     10 33 !pen ." S  asin    C  acos       T  atan   /"
  244.     10 41 !pen ." oPt-P ∏    r  radians    d  deG    ^"
  245.     10 49 !pen ." dn/del droP         uP  duPlicate"
  246.     10 57 !pen ." left  swaP          riGht  roll"
  247.     10 65 !pen ." = chanGe siGn       — reciPricol"
  248.     10 73 !pen ." [ less places       ] more places"
  249.     black buffer_rect rframe
  250.     22 90 !pen sysfont red  ." Press a key to go on." ;
  251.  
  252.  
  253. \ define and execute commands via a look up table:
  254. \      32 bit enties:  key.char(16), rel.addr(16)
  255. \
  256. variable #DEFS  0 #defs !    \ number of keys defined
  257. 400 constant DEF.TABLE.SIZE  \ amount of space for key def. table
  258. variable DEF.TABLE  def.table.size allot  \ key definition table
  259.  
  260. \ find a character in the table, return its index
  261. : CHAR>INDEX ( c -- n )  \ c = character (key pressed) 
  262.     0 swap  #defs @ 0 DO           \ for each defined key
  263.       r 4 *  def.table + @         \ check the key.char
  264.       over = IF                    \ if it's a match
  265.         swap drop r 1+ swap LEAVE  \ leave index into table on stack
  266.     THEN  LOOP drop ;              \ n=0 if no match
  267.  
  268. \ get the execution address of item n in key definition table
  269. : INDEXED_ROUTINE ( n -- addr )  \ n = 1 based index into def.table
  270.      1 - 4 * def.table + 2+ @ ;  \ addr = associated execution address
  271.  
  272. \ handle command key presses
  273. : DOCOMMAND ( -- )  \ execute routine associated with char in kflag
  274.     @key char>index ?dup IF  indexed_routine execute THEN ;
  275.  
  276. \ handle numeric key presses
  277. : DONUMBER ( -- )  \ if char in kflag is numeric, put it into buffer
  278.     @key ?numeric  #chars 19 < and IF  key>buffer .buffer  THEN ;
  279.  
  280. \ handle any character
  281. : DOKEY ( c -- ) !key donumber docommand ;  \ process a character
  282.  
  283. \ Fill the table with ascii characters and execution addresses
  284. \ defining words to create routines for individual command keys
  285. : :K ( -- addr )  \ start a key definition
  286.     #defs @ 4 * 4 + def.table.size > IF  \ check room left in table
  287.       beep ." Out of key space." quit    \ warn if table is full
  288.     ELSE  here [ ' ] compile ] THEN ;    \ otherwise begin compiling
  289. : ASSIGN_KEY ( addr c -- )   \ assign a char and execution addr
  290.     #defs @ 4 * def.table +  \ -- addr of next entry in key def table
  291.     >r  r ! r> 2+ !          \ store addr and char in table
  292.     1 #defs +! ;             \ increment table index
  293.  
  294. \                         key definitions
  295. \ enter & return
  296. :K  ?overflow IF keep   \ protect from overflow
  297.       #chars IF  enter   \ if inputting, put on stack
  298.       ELSE  unary fdup    \ otherwise duplicate top o stk
  299.       THEN .calc           \ enter & return
  300.     ELSE beep THEN ;  dup  3 assign_key  13 assign_key
  301.  
  302. \ delete
  303. :K  #chars IF
  304.       kbuff c@  1-  kbuff c!  \ if inputting, back up 1 char
  305.       -1 ^kbuff +!  .buffer     \ otherwise drop from stack
  306.     ELSE  keep unary fdrop .stack  THEN ;  dup  8 assign_key  \ del = drop
  307.                                           ascii D assign_key   \ or D
  308. \ change sign
  309. :K  keep enter unary fdup fdup f+ f- .calc ;  ascii = assign_key  \ +/- sign
  310.  
  311. \ more/less digits
  312. :K  places @ 1-  0 max places ! .stack ;  ascii [ assign_key  \ less places
  313. :K  places @ 1+ 17 min places ! .stack ;  ascii ] assign_key  \ more places
  314.  
  315. \ stack manipulation
  316. :K  ?overflow IF keep unary fdup .stack  THEN ;  30 assign_key  \ up = dup
  317. :K  keep unary fdrop .stack ;                    31 assign_key  \ down = drop
  318. :K  10 needs 0= IF keep fswap .calc THEN ;       28 assign_key  \ left = swap
  319. :K  10 needs 0= IF
  320.       keep depth 5 / froll .calc THEN ;          29 assign_key  \ right = roll
  321.  
  322. \ math functions
  323. :K  keep enter binary f+ .calc ;  ascii + assign_key           \ plus
  324. :K  #chars ^kbuff @ 1- c@ dup >r     \ if prev char is e or E
  325.     101 = r> 69 = or and IF          \ then its a negative exponent
  326.       key>buffer .buffer ELSE        \ so put it in the buffer
  327.       keep enter binary f- .calc THEN ;  ascii - assign_key    \ minus
  328. :K  keep enter binary f* .calc ;  ascii * assign_key           \ times
  329. :K  keep enter binary f/ .calc ;  ascii / assign_key           \ divide
  330. :K  keep enter binary f^ .calc ;  ascii ^ assign_key           \ exponent
  331. :K  keep enter unary -1.0 f^ .calc ;  ascii _ assign_key       \ recipricol
  332. :K  keep enter unary fln .calc ;  ascii n assign_key           \ nat. log
  333. :K  keep enter unary fexp .calc ;  ascii x assign_key          \ e^x
  334. :K  keep enter unary fabs .calc ;  ascii \ assign_key          \ abs. value
  335. :K  keep enter unary fint .calc ;  ascii i assign_key          \ int. part
  336. :K  keep enter unary fdup fint f- .calc ;  ascii f assign_key  \ frac.
  337. :K  keep enter unary atype f@ f/ fsin .calc ;  ascii s assign_key   \ sin
  338. :K  keep enter unary atype f@ f/ fcos .calc ;  ascii c assign_key   \ cos
  339. :K  keep enter unary atype f@ f/ ftan .calc ;  ascii t assign_key   \ tan
  340. :K  keep enter unary acos atype f@ f* .calc ;  ascii C assign_key   \ acos
  341. :K  keep enter unary fatn atype f@ f* .calc ;  ascii T assign_key   \ atan
  342. :K  keep enter unary asin atype f@ f* .calc ;  ascii S assign_key   \ asin
  343. :K  ?overflow IF keep pi .stack  ELSE beep THEN ;  ascii π assign_key  \ pi
  344. :K  keep enter unary log .calc ;  ascii l assign_key                \ log
  345.  
  346. \ set degrees or radians for trig functions
  347. :K  1.0 atype f! .calc ;  ascii r assign_key  \ radians
  348. :K  d/r atype f! .calc ;  ascii d assign_key  \ degrees
  349.  
  350. \ help: draws a little table of key assignments
  351. :K  ['] .help 14 +md !             \ set update 
  352.     .help  BEGIN ?terminal UNTIL    \ display and wait
  353.     ['] .calc 14 +md !               \ reset update  
  354.     black page .calc ;  ascii ? assign_key
  355.  
  356. \ tab: returns to Pocket Forth, keeps stack and input buffer
  357. :K  384 178 wsize  "pocketforth" wtitle  monaco9
  358.     big_cr ." Type ‘CALC {return}’ to return to the calculator." cr
  359.     ['] beep  18 +md @  2+ @      !  \ reset undo handler
  360.     ['] beep  18 +md @  2+ @  4 + !  \ cut handler
  361.     ['] beep  18 +md @  2+ @  6 + !  \ copy handler
  362.     ['] beep  18 +md @  2+ @ 10 + !  \ clear handler
  363.     [ 18 +md @  2+ @  8 + @ literal ] 18 +md @  2+ @  8 + !  \ paste
  364.     [ 14 +md @ literal ]  14 +md !     \ reset update handler
  365.     [ ' fnumber 34 + @ literal ]  ['] fnumber 34 +  !  \ reset error
  366.     tib 80 32 fill                       \ clear input buffer
  367.     tib >abs ,$ 285E ( move.l [a6]+,a4 )  \ setup input buffer
  368.     quit ;  9 assign_key  ( tab )
  369.  
  370. : CALC ( -- ) \ setup and run this program
  371.     201 101 wsize  "calculator" wtitle  \ set window size & title
  372.     page  sysfont                       \ set chicago 12 font
  373.     300 10 +md !                        \ move wrap boundry right
  374.     ['] undo   18 +md @  2+ @      !    \ set undo handler
  375.     ['] cut    18 +md @  2+ @  4 + !    \ set cut handler
  376.     ['] copy   18 +md @  2+ @  6 + !    \ set copy handler
  377.     ['] paste  18 +md @  2+ @  8 + !    \ set paste handler
  378.     ['] clear  18 +md @  2+ @ 10 + !    \ set clear handler
  379.     kbuff 32 32 fill                    \ empty input buffer
  380.     0 kbuff !  first_char ^kbuff !      \ set input buffer 
  381.     ['] .calc 14 +md !                  \ set update event
  382.     ['] whazat  ['] fnumber 34 + !      \ fnum error
  383.     .calc  BEGIN  key dokey  AGAIN ;    \ do it 'til quit
  384.  
  385. \   To make a turnkey program of this, be sure to load this file
  386. \ into a COPY of Pocket Forth. Then define any apple events you
  387. \ want (see Apple Event examples) and execute the following line:
  388.  
  389. \     ' calc 26 +md !  save bye         \ set startup
  390.  
  391. \   Pocket Forth will quit. When restarted, the calculator program
  392. \ run automatically.
  393. \   Use Resedit to change the bundle, icon, and signature resources,
  394. \ as well as the menus and the about dialog items to create a stand
  395. \ alone application.
  396.  
  397. : .TELL  \ interactive printing utility
  398.     page
  399.     ."   Type “Calc” to enter the calculator program." cr
  400.     ."  Then press “?” for help or ‘tab’ to exit." cr ;
  401. .tell forget .tell
  402.  
  403. -1 28 +md !  ( restore echo )
  404.